home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr50 / mlibv22.zip / DEMO1.BAS < prev    next >
BASIC Source File  |  1993-01-27  |  18KB  |  635 lines
  1.  
  2. '******************************** DEMO1.BAS *********************************
  3. '*                                                                          *
  4. '* NOTE: In order for this demo to run you must start the QB editor         *
  5. '*     : along with the library MLIBN.QLB  (ie., QB/L MLIBN).               *
  6. '*     :                                                                    *
  7. '*     : IF YOU ARE NOT USING QuickBASIC 4.0- 4.5 SEE PAGE 2 OF THE MANUAL  *
  8. '*     : BEFORE TRYING TO RUN THIS DEMO!                                    *
  9. '*     :                                                                    *
  10. '*                                                                          *
  11. '****************************************************************************
  12.  
  13. TYPE MagType
  14.    x1 AS INTEGER
  15.    y1 AS INTEGER
  16.    NX AS INTEGER
  17.    NY AS INTEGER
  18.    WD AS INTEGER
  19.    HT AS INTEGER
  20. END TYPE
  21.  
  22. DEFINT A-Z
  23.  
  24. '$INCLUDE: 'mlib.inc'
  25. DECLARE SUB Doodle ()
  26. DECLARE SUB DoSelect (Choice$, MX%, MY%)
  27. DECLARE SUB Effects ()
  28. DECLARE SUB EndIt ()
  29. DECLARE SUB Magnify ()
  30. DECLARE SUB OpenMsg ()
  31. DECLARE SUB HelpBar ()
  32. DECLARE SUB ReadData ()
  33. DECLARE SUB Reverse (Choice$)
  34. DECLARE SUB ScanPix (MG() AS ANY, N%)
  35. DECLARE SUB ZLoop ()
  36. DECLARE SUB ZMHold (B%, X%, Y%)
  37.  
  38. DECLARE FUNCTION InDoodleArea% ()
  39. DECLARE FUNCTION InMagnifyArea% ()
  40. DECLARE FUNCTION InMenuArea% ()
  41. DECLARE FUNCTION OnTarget% (Selection%)
  42.  
  43. '============================================================================
  44.                                                  
  45. SCREEN 12: CLS : CALL InitPointer(NumBut%)       'Initialize mouse.
  46. IF NumBut% = 0 THEN EndIt                        'No mouse.
  47. CALL DClicRate(7)  '<= DEFAULT=9  1/2 Sec.       'Set double click speed.
  48. CALL DClicBut(1)   '<= DEFAULT=1  Left button    'Check left mouse button.
  49. CALL DClicOn       '<= DEFAULT=ON                'Turn double click on.
  50.                                                  '
  51. OpenMsg                                          '
  52.                                                  '
  53. OPTION BASE 1                                    '
  54. DIM SHARED Buf(1 TO 4, 1 TO 120)                 '
  55. DIM SHARED Shape$(3), HotX%(3), HotY%(3)         '
  56. DIM SHARED MG(1)  AS MagType                     '
  57.                                                  '
  58. GOSUB SetUp                                      '
  59.                                                  '
  60. CALL ReadData                                    'Convert DATA into a shape.
  61.                                                  '
  62. CALL ChangePointer(Shape$(1), HotX%(1), HotY%(1))'Hand shape.
  63.                                                  'DATA block 1.
  64. CALL ShowPointer                                 '
  65.                                                  '
  66. DO                                               'Main loop.
  67.                                                  '
  68.   DO                                             '
  69.      CALL DClicM(BUT%, MX%, MY%, Dble%)          'Get mouse button/location
  70.                                                  'and double click info.
  71.      Ky$ = INKEY$                                '
  72.                                                  '
  73.   LOOP UNTIL Ky$ = CHR$(27) OR BUT% = 1          '
  74.                                                  '
  75.   IF LEN(Ky$) THEN                               '
  76.                                                  '
  77.      EndIt                                       '
  78.                                                  '
  79.   ELSEIF InMenuArea% THEN                        '
  80.                                                  '
  81.      IF Dble% THEN                               '
  82.         CALL DoSelect(Choice$, MX%, MY%)         '
  83.      ELSE                                        '
  84.         CALL Reverse(Choice$)                    '
  85.      END IF                                      '
  86.                                                  '
  87.   ELSEIF Choice$ = "Doodle" THEN Doodle          '
  88.                                                  '
  89.   ELSEIF Choice$ = "Magnify" THEN Magnify        '
  90.                                                  '
  91.                                                  '
  92.   END IF                                         '
  93.                                                  '
  94. LOOP WHILE Ky$ <> CHR$(27)                       '
  95.                                                  '
  96. CALL EndIt                                       '
  97.                                                  '
  98. '============================================================================
  99.  
  100. 'Subroutine ReadData converts this DATA back into a 64 byte string.
  101.  
  102. 'Hand.
  103. 'Source      : DEMO.SHP
  104. 'Destination : DATA.DAT
  105. 'Record      : 2
  106. 'Format      : SOLID
  107. DATA &H4,&H0,&HF3FD,&HE1FA,&HE1FB,&HE1FA,&HE1FD,&HE049,&HE000
  108. DATA &H8000,&H0,&H0,&H0,&H0,&H8000,&HC001,&HE003,&HE003
  109. DATA &H0,&HC00,&HC00,&HC00,&HC00,&HC00,&HDB6,&HDB6,&H6DB6
  110. DATA &H6FFE,&H6FFE,&H7FFE,&H3FFE,&H1FFC,&HFF8,&H0
  111.  
  112. 'Magnify
  113. 'Source      : DEMO.SHP
  114. 'Destination : DATA.DAT
  115. 'Record      : 11
  116. 'Format      : SOLID
  117. DATA &H6,&H5,&HE07D,&HD0BA,&HBFDB,&H7FEA,&H3BCD,&H3D4F,&H2BCF
  118. DATA &H3DCF,&H7FEF,&HBFDF,&HD08F,&HE057,&HFFEB,&HFFF5,&HFFFA,&HFFFC
  119. DATA &H0,&HF00,&H0,&H0,&H4420,&H42A0,&H5420,&H4220,&H0
  120. DATA &H0,&HF00,&H0,&H0,&H0,&H0,&H0
  121.  
  122. '*** REM this block to view pen in non color. ***
  123. 'Pen.
  124. 'Source      : DEMO.SHP
  125. 'Destination : DATA.DAT
  126. 'Record      : 5
  127. 'Format      : SOLID
  128. DATA &H0,&HF,&HBFE1,&H5FD0,&H7FA0,&H5F41,&HBE83,&HFF07,&HFE0F
  129. DATA &HFC1F,&HF83F,&HF07F,&HE0FF,&HC1FF,&HC3FF,&HC7FF,&HBFFF,&H7FFF
  130. DATA &H0,&H6,&HC,&H18,&H30,&H60,&HC0,&H180,&H300
  131. DATA &H600,&HC00,&H1800,&H1000,&H0,&H0,&H0
  132.  
  133. 'Pen
  134. 'Source      : DEMO.SHP
  135. 'Destination : DATA.DAT
  136. 'Record      : 21
  137. 'Format      : TRANS
  138. DATA &H0,&HF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
  139. DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
  140. DATA &H401E,&HA02F,&H805F,&HA0BE,&H417C,&HF8,&H1F0,&H3E0,&H7C0
  141. DATA &HF80,&H1F00,&H3E00,&H3C00,&H3800,&H4000,&H8000
  142.  
  143. '============================================================================
  144.  
  145. SetUp:
  146.  
  147. NWide% = 9:   NHigh% = NWide%     'Number of gridblocks hor/ver.
  148.     
  149. GSizeH% = 15: GSizeV% = GSizeH%   'Size of each gridblock.
  150. En% = 1
  151. MG(En%).x1 = 480                  'X coordinates.
  152. MG(En%).y1 = 14                   'Y coordinates.
  153. MG(En%).NX = NWide%               'Number of grid blocks wide.
  154. MG(En%).NY = NHigh%               'Number of grid blocks high.
  155. MG(En%).WD = GSizeH%              'Width of each block (In pixels).
  156. MG(En%).HT = GSizeV%              'Height of each block (In pixels).
  157.                                         
  158. PX1% = MG(En%).x1
  159. PY1% = MG(En%).y1
  160. PX2% = PX1% + NWide% * GSizeH%
  161. PY2% = PY1% + NHigh% * GSizeV%
  162.  
  163. LINE (PX1% - 1, PY1% - 1)-(PX2%, PY2%), 15, B
  164.  
  165. LINE (PX1% - 1, PY2% + 15)-(PX2%, PY2% + 296), 15, B
  166.  
  167. LINE (PX1%, PY2% + 16)-(PX2% - 1, PY2% + 295), 4, BF
  168.  
  169. LINE (10, 13)-(470, 35), 15, B
  170.  
  171. LOCATE 2, 7
  172. PRINT "   Quit      Effects      Magnify      Doodle   "
  173.  
  174. CALL HelpBar
  175.  
  176. RETURN
  177.  
  178. SUB Doodle
  179.     
  180. IF InDoodleArea% THEN                       '
  181.                                             '
  182.    CALL GetButtonM(Dummy%, MX%, MY%)        '
  183.    CALL HidePointer                         '
  184.    PSET (MX%, MY%), 15                      'Update position.
  185.    CALL ShowPointer                         '
  186.                                             '
  187.    DO                                       '
  188.                                             '
  189.       ZMHold BUT%, MX%, MY%                 'Loop while pointer is in
  190.                                             'the same position.
  191.       IF InDoodleArea% THEN                 '
  192.          CALL HidePointer                   'Draw a line from old pos
  193.          LINE -(MX%, MY%), 15               'to new.
  194.          CALL ShowPointer                   '
  195.       ELSE                                  '
  196.          EXIT DO                            '
  197.       END IF                                '
  198.                                             '
  199.    LOOP WHILE BUT%                          '
  200.                                             '
  201. END IF                                      '
  202.  
  203. END SUB
  204.  
  205. SUB DoSelect (Choice$, MX%, MY%)
  206.  
  207.    Col% = (MX% \ 8) + 1  'For 8 X 16 character size, SCREEN 12.
  208.    Row% = (MY% \ 16) + 1
  209.   
  210.    IF Row% = 2 THEN
  211.   
  212.       SELECT CASE Col%
  213.  
  214.          CASE 7 TO 16  '................. Quit
  215.             
  216.             EndIt
  217.  
  218.          CASE 17 TO 29 '................. Effects
  219.            
  220.             '*
  221.             '* For demonstration puposes we will:
  222.             '*
  223.             '*        -  get the size of the mouse enviroment
  224.             '*        -  save the mouse state
  225.             '*        -  restore the mouse state
  226.             '*
  227.            
  228.             Size% = GetSizeM%                    'Get size of environment.
  229.            
  230.             Buffer$ = SPACE$(Size%)              'Buffer$ needs to be the
  231.                                                  'same size as the mouse
  232.                                                  'environment.
  233.             HidePointer
  234.                                                  
  235.                CALL SaveStateM(Buffer$, ErrNum%) 'Save environment.
  236.                                                 
  237.                CALL Effects
  238.                                                  
  239.                CALL RestoreStateM(Buffer$, ErrNum%)'Restore environment.
  240.  
  241.  
  242.             IF ErrNum% THEN                      'If an error occurred,
  243.                SetPointer MX%, MY%               'set pointer in original
  244.             END IF                               'position.
  245.                                                  
  246.             ShowPointer
  247.  
  248.          CASE 30 TO 42 '................. Magnify
  249.            
  250.             Choice$ = "Magnify"
  251.             ChangePointer Shape$(2), HotX%(2), HotY%(2)'Mag glass.
  252.                                                        'DATA block 2.
  253.          CASE 43 TO 54 '................. Doodle
  254.            
  255.             Choice$ = "Doodle"
  256.             ChangePointer Shape$(3), HotX%(3), HotY%(3)'Pen.
  257.                                                        'DATA block 3.
  258.       END SELECT
  259.  
  260.    END IF
  261.  
  262. END SUB
  263.  
  264. SUB Effects STATIC
  265.  
  266. GET (17 * 8 - 8, 16)-(29 * 8, 32), Buf(2, 1): PUT (17 * 8 - 8, 16), Buf(2, 1), PRESET
  267.  
  268. LOCATE 29, 2
  269. PRINT "[ Click or key press = Stop ]" + SPACE$(47)
  270.  
  271. PosX% = 160
  272. PosY% = 195
  273.  
  274. DO
  275.   
  276.    CALL GetButtonM(BUT%, x1%, y1%)
  277.    
  278.    Start! = TIMER + .1
  279.    WHILE Done! < Start!: Done! = TIMER
  280.    
  281.       L1 = (L1 MOD 150) - 2
  282.       LINE (PosX% + L1, L1 + PosY%)-((PosX% * 2) - L1, (PosY% + 100) - L1), CLR, B
  283.   
  284.       L2 = (L2 MOD 99) + 1
  285.       LINE (PosX% + L2, L2 + PosY%)-((PosX% * 2) - L2, (PosY% + 100) - L2), CLR, B
  286.   
  287.    WEND
  288.      
  289.    CLR = (CLR + 1) MOD 16
  290.  
  291. LOOP UNTIL LEN(INKEY$) OR BUT%
  292.  
  293. GET (17 * 8 - 8, 16)-(29 * 8, 32), Buf(2, 1): PUT (17 * 8 - 8, 16), Buf(2, 1), PRESET
  294.  
  295. CALL HelpBar
  296.  
  297.  
  298. END SUB
  299.  
  300. SUB EndIt
  301.  
  302. SCREEN 0
  303. CLS
  304. END
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312. END SUB
  313.  
  314. SUB HelpBar
  315.  
  316. VIEW PRINT
  317. LOCATE 29, 2
  318. PRINT "[ Click or Esc = Quit | Double Click = Effects | Click = Magnify or Doodle ]"
  319.  
  320. END SUB
  321.  
  322. FUNCTION InDoodleArea%
  323.           
  324.  
  325. IF InWinM(481, 166, 613, 443) THEN
  326.    InDoodleArea% = -1
  327. ELSE
  328.    InDoodleArea% = 0
  329. END IF
  330.  
  331. 'BASIC equivalent.
  332. 'CALL GetButtonM(BUT%, x1%, y1%)
  333. '
  334. 'SELECT CASE x1%
  335. '
  336. '   CASE 481 TO 613
  337. '
  338. '      SELECT CASE y1%
  339. '
  340. '         CASE 166 TO 443
  341. '
  342. '            InDoodleArea% = -1
  343. '
  344. '         CASE ELSE
  345. '
  346. '            InDoodleArea% = 0
  347. '
  348. '      END SELECT
  349. '
  350. '   CASE ELSE
  351. '
  352. '      InDoodleArea% = 0
  353. '
  354. 'END SELECT
  355.  
  356. END FUNCTION
  357.  
  358. FUNCTION InMagnifyArea%
  359.          
  360. IF InWinM(10, 45, 470, 445) THEN
  361.    InMagnifyArea% = -1
  362.    EXIT FUNCTION
  363. ELSE
  364.    InMagnifyArea% = 0
  365. END IF
  366.  
  367. 'BASIC equivalent.
  368. 'CALL GetButtonM(BUT%, x1%, y1%)
  369. '
  370. 'SELECT CASE x1%
  371. '
  372. '   CASE 10 TO 470
  373. '
  374. '      SELECT CASE y1%
  375. '
  376. '         CASE 45 TO 445
  377. '
  378. '            InMagnifyArea% = -1
  379. '            EXIT FUNCTION
  380. '
  381. '         CASE ELSE
  382. '
  383. '      END SELECT
  384. '
  385. '   CASE ELSE
  386. '
  387. 'END SELECT
  388.  
  389.  
  390. IF InDoodleArea% THEN
  391.    InMagnifyArea% = -1
  392. ELSE
  393.    InMagnifyArea% = 0
  394. END IF
  395.  
  396.  
  397.  
  398. END FUNCTION
  399.  
  400. FUNCTION InMenuArea%
  401.  
  402. IF InWinM(10, 13, 470, 35) THEN
  403.    InMenuArea% = -1
  404. ELSE
  405.    InMenuArea% = 0
  406. END IF
  407.  
  408. 'BASIC equivalent.
  409. 'CALL GetButtonM(BUT%, x1%, y1%)
  410. '
  411. 'SELECT CASE x1%
  412. '
  413. '   CASE 10 TO 470
  414. '
  415. '      SELECT CASE y1%
  416. '
  417. '         CASE 13 TO 35
  418. '
  419. '            InMenuArea% = -1
  420. '
  421. '         CASE ELSE
  422. '
  423. '            InMenuArea% = 0
  424. '
  425. '      END SELECT
  426. '
  427. '   CASE ELSE
  428. '
  429. '      InMenuArea% = 0
  430. '
  431. 'END SELECT
  432.  
  433. END FUNCTION
  434.  
  435. SUB Magnify
  436.     
  437. SHARED En%                                  'Share with main mod.
  438.                                             '
  439. IF InMagnifyArea% THEN                      '
  440.                                             '
  441.    CALL ScanPix(MG(), En%)                  'Scan area to magnify, and
  442.                                             'draw it on the screen.
  443.    ZLoop                                    'Loop while button is down.
  444.                                             '
  445. END IF                                      '
  446.  
  447. END SUB
  448.  
  449. FUNCTION OnTarget% (Selection%)
  450.  
  451.    OnTarget% = -1                           'Let CASE prove otherwise.
  452.   
  453.    CALL GetButtonM(BUT%, MX%, MY%)
  454.  
  455.    Col% = (MX% \ 8) + 1  'For 8 X 16 character size, screen 12.
  456.    Row% = (MY% \ 16) + 1
  457.  
  458.    IF Row% = 2 THEN
  459.  
  460.       SELECT CASE Col%
  461.  
  462.          CASE 7 TO 16:   Selection% = 1     'Quit
  463.          CASE 30 TO 42:  Selection% = 3     'Magnify
  464.          CASE 43 TO 54:  Selection% = 4     'Doodle
  465.          
  466.       CASE ELSE
  467.         
  468.          OnTarget% = 0
  469.  
  470.       END SELECT
  471.      
  472.    ELSE
  473.      
  474.       OnTarget% = 0
  475.  
  476.    END IF
  477.  
  478.    IF BUT% = 0 THEN OnTarget% = 0
  479.  
  480. END FUNCTION
  481.  
  482. SUB OpenMsg
  483.  
  484. PRINT
  485. PRINT "A very simple demo on double clicking, plus a few other general"
  486. PRINT "mouse related procedures."
  487.  
  488. PRINT
  489. PRINT
  490. PRINT "Press a key/button to continue..."
  491.  
  492. DO
  493.   
  494.    CALL GetButtonM(BUT%, x1%, y1%)
  495.   
  496. LOOP UNTIL BUT% OR LEN(INKEY$)
  497.  
  498. CLS
  499.  
  500. END SUB
  501.  
  502. '
  503. '****************************************************************************
  504. '*                                                                          *
  505. '* Read the shape DATA into the Shape$ array.                               *
  506. '*                                                                          *
  507. '*                                                                          *
  508. '****************************************************************************
  509. '
  510. SUB ReadData
  511.  
  512. '============================================================================
  513.  
  514. Y = 0                                            '
  515.                                                  '
  516. FOR X = 1 TO 3                                   '
  517.                                                  '
  518.    Y = Y + 1                                     '
  519.    READ HotX%(Y), HotY%(Y)                       'First 2 statements are
  520.                                                  'X and Y hotspots.
  521.    FOR xdata = 1 TO 32                           '
  522.       READ SHPdata%                              '
  523.       Shape$(Y) = Shape$(Y) + MKI$(SHPdata%)     'Build data string.
  524.    NEXT xdata                                    '
  525.                                                  '
  526. NEXT X                                           '
  527.                                                  '
  528. '============================================================================
  529.  
  530. END SUB
  531.  
  532. SUB Reverse (Choice$)
  533.  
  534. Dummy% = OnTarget%(Selection%)                   'Which one.
  535.  
  536. GOSUB ReverseIt                                  'Reverse colors.
  537.  
  538. IF OnTarget%(Selection%) THEN
  539.   
  540.    CALL GetButtonM(BUT%, MX%, MY%)
  541.   
  542.    CALL DoSelect(Choice$, MX%, MY%)
  543.   
  544.    SaveSelection% = Selection%
  545.  
  546.    WHILE OnTarget%(Selection%): WEND
  547.   
  548.    IF Selection% <> SaveSelection% THEN          'Make sure Selection%
  549.       Selection% = SaveSelection%                'is the same.
  550.    END IF
  551.  
  552.    ZLoop
  553.  
  554. END IF
  555.  
  556. GOSUB ReverseIt
  557.  
  558. ZLoop
  559.  
  560. EXIT SUB
  561.  
  562. ReverseIt:
  563.  
  564. HidePointer
  565.  
  566. SELECT CASE Selection%
  567.    CASE 1: GET (7 * 8 - 8, 16)-(16 * 8, 32), Buf(1, 1):  PUT (7 * 8 - 8, 16), Buf(1, 1), PRESET
  568.    CASE 3: GET (30 * 8 - 8, 16)-(42 * 8, 32), Buf(3, 1): PUT (30 * 8 - 8, 16), Buf(3, 1), PRESET
  569.    CASE 4: GET (43 * 8 - 8, 16)-(54 * 8, 32), Buf(4, 1): PUT (43 * 8 - 8, 16), Buf(4, 1), PRESET
  570. END SELECT
  571.  
  572. ShowPointer
  573.  
  574. RETURN
  575.  
  576. END SUB
  577.  
  578. SUB ScanPix (MG() AS MagType, N%) STATIC
  579.  
  580. CALL GetButtonM(BUT%, MX%, MY%)
  581.  
  582. STX% = MX% - 4 'Starting pixel position.
  583. STY% = MY% - 4
  584.  
  585.  H1% = MG(N%).WD \ 2
  586.  V1% = MG(N%).HT \ 2
  587.  XG% = MG(N%).x1 + H1%
  588.  YG% = MG(N%).y1 + V1%
  589.  RE% = STX% + MG(N%).NX - 1
  590.  CE% = STY% + MG(N%).NY - 1
  591.  
  592. CALL HidePointer
  593.  
  594. 'Scan left to right.
  595. FOR SX% = STX% TO RE%
  596.  
  597.    'Scan top to bottom.
  598.    FOR SY% = STY% TO CE%
  599.  
  600.       Colr% = POINT(SX%, SY%)
  601.       
  602.       'Calculate row and column.
  603.       R1% = XG% + ((SX% - STX%) * MG(N%).WD)
  604.       C1% = YG% + ((SY% - STY%) * MG(N%).HT)
  605.  
  606.       'Draw a filled box with the same color as the pixel.
  607.       LINE (R1% - H1%, C1% - V1%)-(R1% + H1%, C1% + V1%), Colr%, BF
  608.       
  609.    NEXT SY%
  610.  
  611. NEXT SX%
  612.  
  613. CALL ShowPointer
  614.  
  615. END SUB
  616.  
  617. SUB ZLoop
  618.   
  619.    DO
  620.    CALL GetButtonM(BUT%, x1%, y1%)
  621.    LOOP WHILE BUT%
  622.  
  623. END SUB
  624.  
  625. SUB ZMHold (B%, X%, Y%) STATIC
  626.  
  627. OldPos% = X% + Y%
  628.  
  629. DO: CALL GetButtonM(B%, X%, Y%)
  630.  
  631. LOOP UNTIL X% + Y% <> OldPos% OR B% = 0
  632.  
  633. END SUB
  634.  
  635.